COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (array* (fixnum board 1 a 1 b 1 c 1 sequence 1)) 
C00006 ENDMK
C⊗;
(declare (array* (fixnum board 1 a 1 b 1 c 1 sequence 1)) 
	 (fixsw t)
	 (special answer final))

(eval-when (compile load eval)
	   (setq base 10. ibase 10.))

(array board fixnum 16.)
(array sequence fixnum 14.)
(array a fixnum 37.)
(array b fixnum 37.)
(array c fixnum 37.)

(fillarray 'board '(1))
(store (board 5) 0)

(fillarray 'a '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4
		  4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6))

(fillarray 'b '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
		  2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5))

(fillarray 'c '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
		  1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4))

(defun last-position ()
       (do ((i 1 (1+ i)))
	   ((= i 16.) 0)
	   (cond ((= 1 (board i)) (return i)))))

(defun try (i depth)
       (cond ((= depth 14) 
	      (let ((lp (last-position)))
		   (cond ((member lp final))
			 (t (push lp final))))
	      (push (cdr (listarray 'sequence)) answer) t)
	     ((and (= 1 (board (a i)))
		   (= 1 (board (b i)))
		   (= 0 (board (c i))))
	      (store (board (a i)) 0)
	      (store (board (b i)) 0)
	      (store (board (c i)) 1)
	      (store (sequence depth) i)
	      (do ((j 0 (1+ j))
		   (depth (1+ depth)))
		  ((or (= j 36.)
		       (try j depth)) ()))
	      (store (board (a i)) 1)
	      (store (board (b i)) 1)
	      (store (board (c i)) 0)())))

(defun gogogo (i)
       (let ((answer ())
	     (final ()))
	    (try i 1)))

(defun print-answer (l)
 (do ((l l (cdr l)))
     ((null l) 'done)
     (princ (a (car l)))
     (tyo #o9)
     (princ (b (car l)))
     (tyo #o 9)
     (princ (c (car l)))
     (terpri)))

(include "timer.lsp")

(timer timit 
	(gogogo 22.))